home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / tm_autodock / tm_autodock.e < prev    next >
Text File  |  1994-05-02  |  18KB  |  327 lines
  1. /********************************************************************************
  2.  * << AUTO HEADER XDME >>
  3.  ********************************************************************************
  4.  ED           "EDG"
  5.  EC           "EC"
  6.  PREPRO       "EPP"
  7.  SOURCE       "TM_AutoDock.e"
  8.  EPPDEST      "TM_AutoDock_EPP.e"
  9.  EXEC         "TM_AutoDock"
  10.  ISOURCE      "ToolManager.i"
  11.  HSOURCE      " "
  12.  ERROREC      " "
  13.  ERROREPP     " "
  14.  VERSION      "0"
  15.  REVISION     "0"
  16.  NAMEPRG      "TM_AutoDock"
  17.  NAMEAUTHOR   "NasGûl"
  18.  ********************************************************************************
  19.  * HISTORY :
  20.  *******************************************************************************/
  21.  OPT OSVERSION=37
  22. /* Object personnel pour le gestion du Dock */
  23. OBJECT toolmini
  24.     obj_dock_exec:LONG
  25.     obj_dock_image:LONG
  26.     obj_dock_sound:LONG
  27. ENDOBJECT
  28. /* tags de la whatis */
  29. CONST WI_FIB=$800000CA,WI_DEEP=$800000CB,WI_BUFFER=$800000CC,WI_BUFLEN=$800000CD
  30. CONST WI_DLX=$800000CE,WI_DLT=$800000CF,WBF_UPDATEFILETYPE=$01
  31.  
  32. MODULE 'toolmanager','whatis','utility/tagitem','utility/hooks','dos/dos',
  33.        'dos/dosasl','utility','graphics/text','intuition/intuition',
  34.        'commodities','libraries/commodities','exec/ports','icon',
  35.        'asl','libraries/asl','gadtools','libraries/gadtools',
  36.        'libraries/toolmanager','tmhandle','exec/nodes','exec/lists'
  37.  
  38. ENUM ARG_DIR,ARG_COL,ARG_HOTKEY,ARG_ICON,ARG_POPUP,ARG_ARG,NUMARGS
  39.  
  40. ENUM ER_NONE,ER_BADARGS,ER_WHATISLIB,ER_TMHANDLE,ER_TMLIB,ER_ALLOCHANDLE,ER_MEM,ER_OBJEXEC,
  41.      ER_CREATEDOCK,ER_DIRONLY,ER_NOEXEC,ER_OBJIMAGE,ER_CXLIB,ER_CREATEPORT,ER_BROKER,
  42.      ER_CXFOBJ,ER_CXSOBJ,ER_CXTOBJ,ER_CXERROR,ER_ICONLIB,ER_INTUILIB,ER_GADTOOLSLIB
  43.  
  44. RAISE ER_MEM IF New()=NIL,
  45.       ER_MEM IF String()=NIL
  46.  
  47. DEF debug=FALSE                             /* variable pour le debugprint */
  48. DEF dossier[256]:STRING,col                 /* dossier,nbrs de colonnes  passé en arg */
  49. DEF hotkey[20]:STRING                       /* hotkey passé en arg */
  50. DEF flag_icon=FALSE                         /* icône passé en arg */
  51. DEF flag_popup=FALSE                        /* popup passé en arg */
  52. DEF flag_arg=FALSE                          /* argument pour les object Exec */
  53. DEF list_tagic[1000]:LIST                   /* list des tags du dock */
  54. DEF handle:PTR TO tmhandle                  /* handle toolmanager */
  55. DEF num_icon[1000]:ARRAY OF LONG            /* stockage du nom des objects Icon et Exec pour TM */
  56. DEF num_exec[1000]:ARRAY OF LONG            /* stockage de la commade exec de l'object Exec */
  57. DEF cxmybroker:PTR TO newbroker             /* CxObject de la commoditie */
  58. DEF cxmsgport:PTR TO mp                     /* Port de message */
  59. DEF cxfilterobj       /*:PTR TO newbroker*/
  60. DEF cxsenderobj       /*:PTR TO newbroker*/  /** LOOK THE HORRIBLE open_libraries() proc. **/
  61. DEF cxtranslateobj    /*:PTR TO newbroker*/
  62. DEF mynewbroker:PTR TO newbroker
  63. PROC main() HANDLE /*"main()"*/
  64. /********************************************************************************
  65.  * Para         : NONE
  66.  * Return       : NONE
  67.  * Description  : Main Proc.
  68.  *******************************************************************************/
  69.     DEF args[NUMARGS]:LIST,templ,x,rdargs=NIL   /* Lecture Argument cli */
  70.     DEF test_main                               /* Variable de test     */
  71.     DEF id,res,reel_quit=FALSE,active=TRUE
  72.     VOID {prg_banner}
  73.     /* On ouvre les libraries */
  74.     IF (test_main:=open_libraries())<>ER_NONE THEN Raise(test_main)
  75.     /* Lecture des arguments CLI */
  76.     FOR x:=0 TO NUMARGS-1 DO args[x]:=0
  77.     templ:='DOSSIER,COL/K/N,HK=HOTKEY/K,ICON/S,POPUP/S,ARG/S'
  78.     rdargs:=ReadArgs(templ,args,NIL)
  79.     IF rdargs=NIL THEN Raise(ER_BADARGS)                       /* Erreur Argument */
  80.     /* Initialisation des variables d'arguments */
  81.     IF args[ARG_DIR] THEN StrCopy(dossier,args[ARG_DIR],ALL)
  82.     IF args[ARG_HOTKEY] THEN StrCopy(hotkey,args[ARG_HOTKEY],ALL) ELSE hotkey:=NIL
  83.     IF args[ARG_COL] THEN col:=Long(args[ARG_COL]) ELSE col:=1
  84.     IF args[ARG_ICON] THEN flag_icon:=TRUE ELSE flag_icon:=FALSE
  85.     IF args[ARG_POPUP] THEN flag_popup:=TRUE ELSE flag_popup:=FALSE
  86.     IF args[ARG_ARG] THEN flag_arg:=TRUE ELSE flag_arg:=FALSE
  87.     IF debug THEN WriteF('\s \d \s \d \d\n',dossier,col,hotkey,flag_icon,flag_popup)
  88.     /* On reserve un handle de TM */
  89.     IF (handle:=AllocTMHandle())=NIL THEN Raise(ER_ALLOCHANDLE)
  90.     /* On initilise l'objet Dock de TM (stocké dans une liste) */
  91.     ListCopy(list_tagic,[TMOP_ACTIVATED,TRUE,
  92.                          TMOP_CENTERED,TRUE,
  93.                          TMOP_FRONTMOST,TRUE,
  94.                          TMOP_VERTICAL,FALSE,
  95.                          TMOP_COLUMNS,col,
  96.                          TMOP_TEXT,Not(flag_icon),
  97.                          TMOP_HOTKEY,hotkey,
  98.                          TMOP_MENU,FALSE,
  99.                          TMOP_POPUP,flag_popup,
  100.                          TMOP_TOFRONT,active,
  101.                          TMOP_FONT,['topaz.font',8,0,0]:textattr,
  102.                          TMOP_TITLE,dossier],ALL)
  103.     /* On regarde dans le dossier et on construit le Dock */
  104.     IF (test_main:=read_dossier())<>ER_NONE THEN Raise(test_main)
  105.     /* On crée le Dock */
  106.     IF (test_main:=CreateTMObjectTagList(handle,'b',TMOBJTYPE_DOCK,list_tagic))=NIL THEN Raise(ER_CREATEDOCK)
  107.     p_WriteFList(handle.lobjexec)
  108.     REPEAT
  109.         IF res:=GetMsg(cxmsgport)
  110.             id:=CxMsgID(res)
  111.             SELECT id
  112.                 CASE $13
  113.                     EasyRequestArgs(0,[20,0,0,'  <<<< TM-AutoDock v0.0 © 1994 NasGûl >>>>  \n'+
  114.                                               '                                            \n'+
  115.                                               'ToolManager.library © Stefan Becker.        \n'+
  116.                                               'WhatIs.library      © S. Rougier/P. Carette.\n'+
  117.                                               'Amiga_E             © W.V Oortmerssen.','Merci'],0,NIL)
  118.  
  119.                 CASE $17; reel_quit:=TRUE
  120.                 DEFAULT; NOP
  121.             ENDSELECT
  122.             ReplyMsg(res)
  123.         ELSE
  124.             WaitPort(cxmsgport)
  125.         ENDIF
  126.     UNTIL reel_quit=TRUE
  127.     Raise(ER_NONE)
  128. EXCEPT
  129.     IF rdargs THEN FreeArgs(rdargs)
  130.     IF cxmybroker THEN DeleteCxObjAll(cxmybroker)
  131.     IF cxmsgport
  132.         WHILE res:=GetMsg(cxmsgport) DO ReplyMsg(res)
  133.         DeleteMsgPort(cxmsgport)
  134.     ENDIF
  135.     IF whatisbase THEN CloseLibrary(whatisbase)
  136.     IF toolmanagerbase THEN CloseLibrary(toolmanagerbase)
  137.     IF cxbase THEN CloseLibrary(cxbase)
  138.     IF iconbase THEN CloseLibrary(iconbase)
  139.     IF intuitionbase THEN CloseLibrary(intuitionbase)
  140.     IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  141.     IF handle THEN FreeTMHandle(handle)
  142.     SELECT exception
  143.         CASE ER_BADARGS;     WriteF('Mauvais Argument.\n>TM_AutoDock <dossier>\n')
  144.         CASE ER_WHATISLIB;   WriteF('Whatis.library v3 ??\n')
  145.         CASE ER_TMHANDLE;    WriteF('ToolManager no actif.\n')
  146.         CASE ER_TMLIB;       WriteF('ToolManager.library v3 ??n')
  147.         CASE ER_GADTOOLSLIB; WriteF('gadtools.library v3 ??n')
  148.         CASE ER_ALLOCHANDLE; WriteF('Impossible d\aouvir le handle.\n')
  149.         CASE ER_MEM;         WriteF('Erreur de memoire.\n')
  150.         CASE ER_OBJEXEC;     WriteF('Erreur de création d\aun objet Exec.\n')
  151.         CASE ER_CREATEDOCK;  WriteF('Impossible d\aouvir le dock.\n')
  152.         CASE ER_DIRONLY;     WriteF('Mauvais Argument.\n>TM_AutoDock <dossier>\n')
  153.         CASE ER_NOEXEC;      WriteF('Aucun Exec.\n')
  154.         CASE ER_OBJIMAGE;    WriteF('Erreur de création d\aun objet Image.\n')
  155.         CASE ER_CXLIB;       WriteF('commodities.library ???\n')
  156.         CASE ER_CREATEPORT;  WriteF('Impossible de créer le port de message.\n')
  157.         CASE ER_BROKER;      WriteF('Impossible de créer le Broker.\n')
  158.         CASE ER_CXFOBJ;      WriteF('Impossible d crée le Broker filter.\n')
  159.         CASE ER_CXSOBJ;      WriteF('Impossible de créer le Broker Sender.\n')
  160.         CASE ER_CXTOBJ;      WriteF('Impossible de créer le Broker Translate.\n')
  161.         CASE ER_CXERROR;     WriteF('Erreur de création de la commoditie..\n')
  162.         CASE ER_ICONLIB;     WriteF('icon.library ???\n')
  163.         CASE ER_INTUILIB;    WriteF('intuition.library ???\n')
  164.         DEFAULT;         NOP
  165.     ENDSELECT
  166. ENDPROC
  167. PROC read_dossier() /*"read_dossier()"*/
  168. /********************************************************************************
  169.  * Para         : NONE
  170.  * Return       : ER_NONE if ok,else the error.
  171.  * Description  : Build All Docks for toolmanager.
  172.  *******************************************************************************/
  173.     DEF lock,fib:fileinfoblock            /* Pour faire le 'dir' */
  174.     DEF id_type                           /* id_type pour la whatis.library */
  175.     DEF id_str[9]:STRING                  /* stockage du nom du filetype de la whatis.library */
  176.     DEF fichier[80]:STRING                /* stockage pour le chemin complet du fichier courant */
  177.     DEF test_in_dock                      /* variable de test pour connaitre si le fichier et un executable */
  178.     DEF count=0                           /* compteur */
  179.     DEF piv_stock:PTR TO toolmini         /* pointeur sur ma ministructure */
  180.     DEF t_exists                          /* variable de test pour voir l'existence d'une icône associée à l'executable */
  181.     DEF type_exec                         /* variable pour la définition du flag TMOP_EXECTYPE de l'objet Exec courant (WB/cli)*/
  182.     DEF nom_ic[80]:STRING                 /* Stockage pour le nom des objects Icon et Exec */
  183.     DEF out[100]:STRING                   /* Stockage de la déscription de la fenêtre con: si l'executable n'as pas d'icône */
  184.     IF lock:=Lock(dossier,-2)
  185.         IF Examine(lock,fib)
  186.             IF fib.entrytype<0            /* Un nom de fichier a été passé en arg ERROR */
  187.                 UnLock(lock)
  188.                 RETURN ER_DIRONLY
  189.             ENDIF
  190.             WHILE ExNext(lock,fib)
  191.                 NameFromLock(lock,fichier,256)                 /* stocke dans fichier le nom racine du fichier courant */
  192.                 AddPart(fichier,'',256)                        /* ajoute le / si besoin */
  193.                 StringF(fichier,'\s\s',fichier,fib.filename)   /* reconstruit le chemin+nom du fichier */
  194.                 id_type:=WhatIs(fichier,[WI_DEEP,1])           /* interogatoire de la Whatis.library */
  195.                 id_str:=GetIDString(id_type)                   /* ça continue .. */
  196.                 test_in_dock:=in_doc(id_str)                   /* On regarde si c'est un executable */
  197.                 IF test_in_dock                                /* si oui on y vas */
  198.                     StrCopy(nom_ic,fib.filename,ALL)           /* stock le nom du programme dans nom_ic */
  199.                     num_icon[count]:=String(EstrLen(nom_ic))   /* réserve la mémoire pour nom_ic */
  200.                     StrCopy(num_icon[count],nom_ic,ALL)        /* copie le nom dans la place réservé plus haut */
  201.                     num_exec[count]:=String(EstrLen(fichier))  /* réserve la mémoire pour le nom de l'executable (nom complet chemin/fichier) */
  202.                     StrCopy(num_exec[count],fichier,ALL)       /* copie le nom de l'executable dans la place réservé plus haut */
  203.                     StringF(nom_ic,'\s.info',fichier)          /* reconstruit le nom reel du fichier icône associé a l'executable */
  204.                     IF (t_exists:=exist_fichier(nom_ic))>-1    /* si il y a une icône */
  205.                         type_exec:=TMET_WB                     /* on lancera l'object Exec du workbench */
  206.                         out:=''                                /* sans ouvrir de fenêtre de sortie */
  207.                     ELSE                                       /* sinon */
  208.                         type_exec:=TMET_CLI                    /* on lance en cli */
  209.                         out:='con:0/0/640/56/TM_AutoDock OutPut/CLOSE/WAIT'  /* avec cette fenêtre de sortie */
  210.                     ENDIF
  211.                     /* On crée un object Exec du nom de l'executable */
  212.                     IF (CreateTMObjectTagList(handle,num_icon[count],TMOBJTYPE_EXEC,                 /* Type d'objet Exec */
  213.                                                                      [TMOP_ARGUMENTS,flag_arg,       /* Avec ou sans argument  */
  214.                                                                       TMOP_COMMAND,num_exec[count],  /* commande associé  */
  215.                                                                       TMOP_EXECTYPE,type_exec,       /* WB ou Cli */
  216.                                                                       TMOP_CURRENTDIR,dossier,       /* CD automatique */
  217.                                                                       TMOP_OUTPUT,out,                /* Sortie standart */
  218.                                                                       TAG_DONE]))=NIL THEN RETURN ER_OBJEXEC
  219.                     /* Si le flag icon est mis */
  220.                     IF flag_icon=TRUE
  221.                         /* On construit un objet Image */
  222.                         IF (CreateTMObjectTagList(handle,num_icon[count],TMOBJTYPE_IMAGE,[TMOP_FILE,fichier,TAG_DONE]))=NIL THEN RETURN ER_OBJIMAGE
  223.                     ENDIF
  224.                     /* On initilise ma ministructure */
  225.                     piv_stock:=New(SIZEOF toolmini)
  226.                     /* On associe les deux objets (Exec et Image) ensemble */
  227.                     piv_stock.obj_dock_exec:=num_icon[count]
  228.                     piv_stock.obj_dock_image:=num_icon[count]
  229.                     piv_stock.obj_dock_sound:=NIL                 /* Pas de son...*/
  230.                     ListAdd(list_tagic,[TMOP_TOOL,piv_stock],2)   /* On ajoute tout ça a l'objet Dock */
  231.                     IF debug THEN WriteF('Fichier \s \s \d\n',num_icon[count],num_exec[count],type_exec)
  232.                     count:=count+1                                /* on continue..*/
  233.                 ENDIF
  234.             ENDWHILE
  235.         ENDIF
  236.         UnLock(lock)
  237.     ELSE
  238.         WriteF('Lock Ipossible.\n')
  239.     ENDIF
  240.     /* si il n'y a pas d'executable c'est pas la peine de continuer */
  241.     IF count=0 THEN RETURN ER_NOEXEC ELSE RETURN ER_NONE
  242. ENDPROC
  243. PROC in_doc(id_str) /*"in_doc(id_str)"*/
  244. /********************************************************************************
  245.  * Para         : Id String (STRING) whatis.library.
  246.  * Return       : TRUE if file in dock ,else FALSE
  247.  * Description  : Choose all Exe.
  248.  *******************************************************************************/
  249.     /* ID de la WhatIs.library pris en compte */
  250.     IF StrCmp(id_str,'Exe',3) THEN RETURN TRUE
  251.     IF StrCmp(id_str,'Pure Exe',7) THEN RETURN TRUE
  252.     IF StrCmp(id_str,'PP40 Exe',8) THEN RETURN TRUE
  253.     IF StrCmp(id_str,'PP30 Exe',8) THEN RETURN TRUE
  254.     IF StrCmp(id_str,'PP Exe',5) THEN RETURN TRUE
  255.     IF StrCmp(id_str,'Script',6) THEN RETURN TRUE
  256.     RETURN FALSE
  257. ENDPROC
  258. PROC open_libraries() /*"open_librarie()"*/
  259. /********************************************************************************
  260.  * Para         : NONE
  261.  * Return       : ER_NONE if ok,else the error.
  262.  * Description  : Open Libraries (exit if no ToolManager Handler).
  263.  *                Build the commodities (newbroker).
  264.  *******************************************************************************/
  265.     DEF test_toolhandle
  266.     mynewbroker:=[NB_VERSION,0,'TM_AutoDock',
  267.                    'TM_AutoDock © 1994 NasGûl',
  268.                    'Dock Automatique pour ToolManager',
  269.                    NBU_UNIQUE OR NBU_NOTIFY,
  270.                    COF_SHOW_HIDE,                /* COF_SHOW_HIDE */
  271.                    0,0,NIL,0]:newbroker
  272.     IF (whatisbase:=OpenLibrary('whatis.library',3))=NIL THEN RETURN ER_WHATISLIB
  273.     /* si ToolManager n'est pas actif toute tentative d'ouvrir la librarie lance TM */
  274.     /* avant.                                                                       */
  275.     IF (test_toolhandle:=FindTask('ToolManager Handler'))=NIL THEN RETURN ER_TMHANDLE
  276.     IF (toolmanagerbase:=OpenLibrary('toolmanager.library',3))=NIL THEN RETURN ER_TMLIB
  277.     IF (cxbase:=OpenLibrary('commodities.library',37))=NIL THEN RETURN ER_CXLIB
  278.     IF (iconbase:=OpenLibrary('icon.library',37))=NIL THEN RETURN ER_ICONLIB
  279.     IF (intuitionbase:=OpenLibrary('intuition.library',37))=NIL THEN RETURN ER_INTUILIB
  280.     IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN ER_GADTOOLSLIB
  281.     /* On crée le port de message */
  282.     IF (cxmsgport:=CreateMsgPort())=NIL THEN RETURN ER_CREATEPORT
  283.     /* On attache notre structure newbroker a ce port */
  284.     mynewbroker.port:=cxmsgport
  285.     IF (cxmybroker:=CxBroker(mynewbroker,NIL))=NIL THEN RETURN ER_BROKER
  286.     /***** ?????? AU HASARD ?????? *****/
  287.     IF (cxfilterobj:=CreateCxObj(cxmybroker,CX_FILTER,'alt c'))=NIL THEN RETURN ER_CXFOBJ
  288.     AttachCxObj(cxmybroker,cxfilterobj)
  289.     IF (cxsenderobj:=CreateCxObj(cxmybroker,CX_SEND,cxmsgport))=NIL THEN RETURN ER_CXSOBJ
  290.     AttachCxObj(cxfilterobj,cxsenderobj)
  291.     IF (cxtranslateobj:=CreateCxObj(cxmybroker,CX_TRANSLATE,NIL))=NIL THEN RETURN ER_CXTOBJ
  292.     AttachCxObj(cxfilterobj,cxtranslateobj)
  293.     IF CxObjError(cxfilterobj) THEN RETURN ER_CXERROR
  294.     ActivateCxObj(cxmybroker,TRUE)
  295.     RETURN ER_NONE
  296. ENDPROC
  297. PROC exist_fichier(nom) /*"exist_fichier(nom)"*/
  298. /********************************************************************************
  299.  * Para         : file (STRING).
  300.  * Return       : the len of file or -1.
  301.  * Description  : Exists() fonction remplacement.
  302.  *******************************************************************************/
  303.     DEF len
  304.     len:=FileLength(nom)
  305.     RETURN len
  306. ENDPROC
  307. PROC p_WriteFList(ptr_list) /*"p_WriteFList(ptr_list)"*/
  308. /********************************************************************************
  309.  * Para         : address of list
  310.  * Return       : NONE
  311.  * Description  : Write the list and node in stdout.
  312.  *******************************************************************************/
  313.     DEF w_list:PTR TO lh
  314.     DEF w_node:PTR TO ln
  315.     w_list:=ptr_list
  316.     w_node:=w_list.head
  317.     WriteF('Adr List:\h[8] Head:\h[8] TailPred:\h[8]\n',w_list,w_list.head,w_list.tailpred)
  318.     WHILE w_node
  319.         /*IF w_node.succ<>0*/
  320.             WriteF('Adr:\h[8] Succ:\h[8] Pred:\h[8] Name:\s\n',w_node,w_node.succ,w_node.pred,w_node.name)
  321.         /*ENDIF*/
  322.         w_node:=w_node.succ
  323.     ENDWHILE
  324. ENDPROC
  325. prg_banner:
  326. INCBIN 'TM_AutoDock.header'
  327.